home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / mouse.exe / MOUSESUB.PAS < prev    next >
Pascal/Delphi Source File  |  1989-06-03  |  15KB  |  378 lines
  1.  
  2. { This is the MOUSESUB.PAS include file for the MOUSE.PAS unit. }
  3. { It contains various special mouse routines used by the Mouse unit. }
  4.  
  5. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6. {Special inline functions used by the Mouse unit}
  7.  
  8. {---------------------------------------------------------------------------}
  9. { an inline function to limit an integer between min and max values}
  10. function IntLimit(Val,Min,Max:Integer):Integer;
  11. Inline(
  12.    $58        {  pop AX}
  13.   /$5B        {  pop BX}
  14.   /$59        {  pop CX}
  15.   /$39/$C8    {  cmp AX,CX}
  16.   /$7C/$08    {  jl done}
  17.   /$89/$D8    {  mov AX,BX}
  18.   /$39/$C8    {  cmp AX,CX}
  19.   /$7F/$02    {  jg done}
  20.   /$89/$C8);  {  mov AX,CX}
  21.               {done:}
  22.  
  23.  
  24. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  25. { The following procedures use the mouse functions to provide }
  26. { a higher level of control over the mouse }
  27.  
  28. {---------------------------------------------------------------------------}
  29. { Normalizes a mouse X position to standard position info }
  30.  
  31. function GetMx(X:Integer):Integer;
  32. begin
  33.    case CrtMode of
  34.      0,1 : begin
  35.              if MaxCrtX < 64 then
  36.                 MouseTemp := (X shr 1) div MouseTextWidth      {320x200 text}
  37.              else
  38.                 MouseTemp := X div MouseTextWidth;             {???x??? text}
  39.            end;
  40.      2,3 : MouseTemp := X div MouseTextWidth;                  {640x200 text}
  41.      4,5 : begin
  42.              if HercGraphMouse then
  43.                MouseTemp := X                         {720x348 herc graphics}
  44.              else
  45.                MouseTemp := X shr 1;                       {320x200 graphics}
  46.            end;
  47.      6   : MouseTemp := X;                                 {640x200 graphics}
  48.      7   : MouseTemp := X div MouseTextWidth;                  {640x??? text}
  49.      $D,$13 : MouseTemp := X shr 1;                        {320x200 graphics}
  50.    else
  51.      MouseTemp := X;                                       {640x??? graphics}
  52.    end;
  53.  
  54.    if ZeroMouse then
  55.      GetMx := MouseTemp                        {zero based mouse positioning}
  56.    else
  57.      GetMx := succ(MouseTemp);            {mouse positioning starts with one}
  58. end;
  59.  
  60. {---------------------------------------------------------------------------}
  61. { Normalizes a mouse Y position to standard position info }
  62.  
  63. function GetMy(Y:Integer):Integer;
  64. begin
  65.    if TextMouse then
  66.      MouseTemp := Y div MouseTextHeight     {convert position for text modes}
  67.    else
  68.      MouseTemp := Y;                      {no conversion needed for graphics}
  69.  
  70.    if ZeroMouse then
  71.      GetMy := MouseTemp                        {zero based mouse positioning}
  72.    else
  73.      GetMy := succ(MouseTemp);            {mouse positioning starts with one}
  74. end;
  75.  
  76. {---------------------------------------------------------------------------}
  77. { converts a standard X position to a mouse X position }
  78.  
  79. function PutMx(X:Integer):Integer;
  80. begin
  81.    if ZeroMouse then
  82.      MouseTemp := X                            {zero based mouse positioning}
  83.    else
  84.      MouseTemp := pred(X);                {mouse positioning starts with one}
  85.  
  86.    if MouseTemp < 0 then                                 {clip value to zero}
  87.      MouseTemp := 0;
  88.  
  89.    case CrtMode of
  90.      0,1 : begin
  91.              if MaxCrtX < 64 then
  92.                PutMx := (MouseTemp * MouseTextWidth) shl 1     {320x200 text}
  93.              else
  94.                PutMx := MouseTemp * MouseTextWidth;            {???x??? text}
  95.            end;
  96.      2,3 : PutMx := MouseTemp * MouseTextWidth;                {640x200 text}
  97.      4,5 : begin
  98.              if HercGraphMouse then
  99.                PutMx := MouseTemp                     {720x348 herc graphics}
  100.              else
  101.                PutMx := MouseTemp shl 1;                   {320x200 graphics}
  102.            end;
  103.      6   : PutMx := MouseTemp;                             {640x200 graphics}
  104.      7   : PutMx := MouseTemp * MouseTextWidth;                {640x??? text}
  105.      $D,$13 : PutMx := MouseTemp shl 1;                    {320x200 graphics}
  106.    else
  107.      PutMx := MouseTemp;                                   {640x??? graphics}
  108.    end;
  109. end;
  110.  
  111. {---------------------------------------------------------------------------}
  112. { converts a standard Y position to a mouse Y position }
  113.  
  114. function PutMy(Y:Integer):Integer;
  115. begin
  116.    if ZeroMouse then
  117.      MouseTemp := Y                            {zero based mouse positioning}
  118.    else
  119.      MouseTemp := pred(Y);                {mouse positioning starts with one}
  120.  
  121.    if MouseTemp < 0 then                                 {clip value to zero}
  122.      MouseTemp := 0;
  123.  
  124.    if TextMouse then
  125.      PutMy := MouseTemp * MouseTextHeight   {convert position for text modes}
  126.    else
  127.      PutMy := MouseTemp;                  {no conversion needed for graphics}
  128. end;
  129.  
  130. {---------------------------------------------------------------------------}
  131. { This procedure is not a standard mouse function. It is however needed to }
  132. { work with the Hercules graphics display. When you use the Hercules }
  133. { graphics display you must call this with the proper display page after }
  134. { you call InitGraph, but before you call InitMouse. InitGraph needs CrtMode}
  135. { to be at 7 to detect the Herc display, but the Mouse needs it at 5 or 6 }
  136. { to detect when the Herc card is in graphs mode. (The Herc card has no }
  137. { provision for telling the system that it is graphics mode.) }
  138. { Note: Be sure to call this procedure with a Pg of -1 if you turn graphics }
  139. { off or anytime before you call InitGraph or DetectGraph. The Mouse unit }
  140. { contains an Exit procedure that calls SetHercMouse with a value of -1 if }
  141. { a Hercules graph mode was selected so that the CrtMode byte will be }
  142. { properly restored on exit from the program. }
  143.  
  144. procedure SetHercMouse(Pg:Integer);
  145. begin
  146.   Case Pg of
  147.     0 : begin
  148.           CrtMode := 6;       { put mouse on Hercules graphics display Pg 0 }
  149.           HercGraphMouse := true;
  150.         end;
  151.     1 : begin
  152.           CrtMode := 5;       { put mouse on Hercules graphics display Pg 1 }
  153.           HercGraphMouse := true;
  154.         end;
  155.   else
  156.     begin
  157.       CrtMode := 7;        { indicate that Hercules display is in text mode }
  158.       HercGraphMouse := false;
  159.     end;
  160.   end;
  161. end;
  162.  
  163. {---------------------------------------------------------------------------}
  164. { Check if a mouse point is currently in the specified area}
  165. { returns true if it is, false if not}
  166. {  Recommended calling method: }
  167. {  If MousePointIn(GetMx(Mx),GetMy(My),x1,y1,x2,y2) then DoSomething;}
  168.  
  169. function MousePointIn(Mx,My, x1,y1,x2,y2:Integer):Boolean;
  170. begin
  171.    if (Mx >= x1) and
  172.       (Mx <= x2) and                               {check if in the box area}
  173.       (My >= y1) and
  174.       (My <= y2) then
  175.      MousePointIn := true                          {<-- return true if it is}
  176.    else
  177.      MousePointIn := false;                   {<-- return false if it is not}
  178. end;
  179.  
  180.  
  181. {---------------------------------------------------------------------------}
  182. function MouseClick:Boolean;           {has the mouse been clicked recently?}
  183. begin
  184.    MouseClick := MouseClicked;               {get a copy of the click status}
  185.    MouseClicked := false;                             {then clear the status}
  186. end;
  187.  
  188.  
  189. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  190. { the following are misc subroutines used by the Mouse unit }
  191.  
  192. {---------------------------------------------------------------------------}
  193. { This is called by InitMouse to initialize the mouse mode flags}
  194. { Note: if you are using a Hercules display card in graphics mode,}
  195. { you must call the SetHercMouse() procedure before calling InitMouse}
  196.  
  197. procedure InitMouseMode;
  198. begin
  199.    MouseAreaX1 := 0;                          {initialize mouse bounded area}
  200.    MouseAreaY1 := 0;                               {assume defaults to start}
  201.    MouseAreaX2 := 639;
  202.    MouseAreaY2 := 199;
  203.    MouseTextWidth := 8;                   {BIOS characters are always 8 wide}
  204.    MouseTextHeight := 8;                     {def